#!/usr/bin/env gosh
(use srfi-1)
(use srfi-43)
(use gauche.sequence)

(define (up lst)
  (cond
   [(null? lst) '()]
   [else
    (cond
     [(list? (car lst))
      (append (car lst) (up (cdr lst)))]
     [(pair? (car lst))
      (append (list (caar lst) (cdar lst)) (cdr lst))]
     [else
      (cons (car lst) (up (cdr lst)))])]))
(define (flatten slist)
  (define (upup o)
    (if (pair? o)
        (if (find pair? o)
            (upup (up o))
            o)
        o))
  (remove null? (upup slist)))

(define (vector->cpp name obj)
  (define symbols  (delete-duplicates (filter symbol? (flatten (vector->list obj)))))
  (define (obj->cpp obj)
    (cond
     [(symbol? obj)
      (receive (index o) (find-with-index (lambda (x) (eq? x obj)) symbols)
        (unless o
          (error "symbol not found" obj))
        (format "symbols[~d]" index))]
     [(number? obj)
      (format "MI(~d)" obj)]
     [(and (pair? obj) (eq? (car obj) '*insn*))
      (format "MIS(~d)" (second obj))]
     [(and (pair? obj) (eq? (car obj) '*compiler-insn*))
      (format "MCI(~d)" (second obj))]
     [(pair? obj)
      (format "Object::cons(~a, ~a)" (obj->cpp (car obj)) (obj->cpp (cdr obj)))]
     [(regexp? obj)
      (format "Object::makeRegexp(UC(~s))" (regexp->string obj))]
     [(string? obj)
      (if (string=? obj "\n")
          (format "Object::makeString(UC(\"\\n\"))")
          (format "Object::makeString(UC(~s))" obj))]
     [(vector? obj)
      (format "Object::makeVector(~a)" (obj->cpp (vector->list obj)))
      ]
     [(char? obj)
      (cond
       [(char=? obj #\space)
        "Object::makeChar(' ')"]
       [(char=? obj #\newline)
        "Object::makeChar('\\n')"]
       [else
        (format "Object::makeChar('~a')" obj)])]
     [(boolean? obj)
      (if obj "Object::True" "Object::False")]
     [(null? obj) "Object::Nil"]
     [else
      (error "unknown object" obj)]))
  (define (make-obj i obj)
    (obj->cpp obj))
  (print "#include \"scheme.h\"\n")
  (print "using namespace scheme;\n")
  (format #t "Object ~a() {\n" name)
  (print "#define MI(i) Object::makeInt(i)")
  (print "#define MIS(i) Object::makeInstruction(i)")
  (print "#define MCI(i) Object::makeCompilerInstruction(i)")
  (print "#define SA(s) Symbol::add(UC(s))\n")
  (print "#define SI(s) Symbol::intern(UC(s))\n")
  (print "\tstatic const Object symbols[] = {")
  (for-each (lambda (x) (format #t "\t\tSA(\"~a\"),\n" x)) symbols)
  (print "\t};")
  (print "\tstatic Object code[] = {")
  (for-each (lambda (x) (format #t "\t\t~a,\n" x)) (vector-map make-obj obj))
  (print "\t};")
  (format #t "\treturn Object::makeVector(~d, code);\n}\n" (vector-length obj)))

(define (main args)
  (format #t "// Do not edit this file generated by ~a.\n" (first args))
  (with-input-from-file (third args)
    (lambda ()
      (let1 obj (read)
        (if (vector? obj)
            (vector->cpp (second args) obj)
            (errorf "~a : vector required, but got ~a" (first args) obj)))))
  0)
